home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / program / p063b9s.zip / UNIT / FUNCSRVR.PAS < prev    next >
Pascal/Delphi Source File  |  1996-04-20  |  3KB  |  116 lines
  1. UNIT FuncSrvr;
  2. { ╔═════════════════════════════════════════════════════════════════════════╗ }
  3. { ║ FUNCSRVR.PAS - Function server routines      Last changed: 20.04.96  SA ║ }
  4. { ║                                                                         ║ }
  5. { ║ (C) Copyright 1989-92 by D. Wulff & S. Ager                             ║ }
  6. { ║                                                                         ║ }
  7. { ║ This source may not be given to anybody, without the written permission ║ }
  8. { ║ from The Portal Team.                                                   ║ }
  9. { ╚═════════════════════════════════════════════════════════════════════════╝ }
  10.  
  11. INTERFACE
  12.  
  13. USES Use32;
  14.  
  15. CONST
  16.   fsForwardFiles     = 1;
  17.   fsCompileNodelist  = 2;
  18.   fsProcessTicks     = 3;
  19.   fsExit             = 4;
  20.  
  21. PROCEDURE RequestFunction(w:WORD);
  22. PROCEDURE InitFunctionServer;
  23. PROCEDURE FunctionServer;
  24. PROCEDURE FinishFunctionServer;   { <--- HVORFOR BLIVER DEN IKKE KALDT }
  25.  
  26. IMPLEMENTATION
  27.  
  28. USES APTimer,
  29.      Globals, NetFile, MTask, FileFwd, NLComp, Tick, Util;
  30.  
  31. TYPE
  32.   FunctionServerType=RECORD
  33.     f    : TNetFile;
  34.     t    : EventTimer;
  35.   END;
  36. VAR
  37.   Fs:^FunctionServerType;
  38.  
  39. PROCEDURE RequestFunction(w:WORD);
  40. BEGIN
  41.   IF Fs=NIL THEN InitFunctionServer;
  42.   Fs^.f.Lock(0,wait);
  43.   Fs^.f.SEEK(Fs^.f.FILESIZE);
  44.   Fs^.f.WRITE(w);
  45.   Fs^.f.Unlock(0);
  46. END;
  47.  
  48. PROCEDURE InitFunctionServer;
  49. BEGIN
  50.   IF Fs=NIL THEN
  51.   BEGIN
  52.     NEW(Fs);
  53.     Fs^.f.Open(StartPath+'PORTAL.FRQ',2,TRUE);
  54.     NewTimerSecs(Fs^.t,15);
  55.   END;
  56. END;
  57.  
  58. PROCEDURE FunctionServer;
  59. VAR
  60.   Buf:ARRAY[1..256] OF WORD;
  61.   Action,i,Num:WORD;
  62.   sp:LONGINT;
  63. BEGIN
  64.   IF Fs=NIL THEN InitFunctionServer;
  65.   IF TimerExpired(Fs^.t) THEN
  66.   BEGIN
  67.     IF Fs^.f.FileSize>0 THEN
  68.     BEGIN
  69.       Fs^.f.Lock(0,Wait);
  70.       Fs^.f.SEEK(0);
  71.       Action:=0;
  72.       WHILE (NOT Fs^.f.EOF) DO
  73.       BEGIN
  74.         sp:=Fs^.f.FILEPOS;
  75.         Fs^.f.BLOCKREADNum(Buf,256,Num);
  76.         FOR i:=1 TO Num DO
  77.           IF Buf[i]<>0 THEN
  78.           BEGIN
  79.             IF Action=0 THEN Action:=Buf[i];
  80.             IF Buf[i]=Action THEN Buf[i]:=0;
  81.           END;
  82.         Fs^.f.SEEK(sp);
  83.         Fs^.f.BLOCKWRITE(Buf,Num);
  84.       END;
  85.       IF Action=0 THEN
  86.       BEGIN
  87.         Fs^.f.SEEK(0);
  88.         Fs^.f.TRUNCATE;
  89.       END;
  90.       Fs^.f.Unlock(0);
  91.       CASE Lo(Action) OF
  92.         fsForwardFiles    : ForwardFiles(False);
  93.         fsCompileNodelist : CompileNodelist(FALSE);
  94.         fsProcessTicks    : ProcessTicks;
  95.         fsExit            : SpawnWithErrorLevel(Hi(Action),'Exit', True);
  96.       END;
  97.     END;
  98.     NewTimerSecs(Fs^.t,15);
  99.   END ELSE
  100.     GiveUpTime;
  101. END;
  102.  
  103. PROCEDURE FinishFunctionServer;
  104. BEGIN
  105.   IF Fs<>NIL THEN
  106.   BEGIN
  107.     Fs^.f.Close;
  108.     DISPOSE(Fs);
  109.     Fs:=NIL;
  110.   END;
  111. END;
  112.  
  113. BEGIN
  114.   Fs:=NIL;
  115. END.
  116.